home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / pibcat.zip / PIBCATY.PAS < prev    next >
Pascal/Delphi Source File  |  1989-04-01  |  12KB  |  259 lines
  1. (*----------------------------------------------------------------------*)
  2. (*     Display_LZH_Contents --- Display contents of archive file    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_LZH_Contents( LZHFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_LZH_Contents                                   *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of an LHARC (.LZH file)              *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_LZH_Contents( LZHFileName : AnyStr );                  *)
  16. (*                                                                      *)
  17. (*          LZHFileName --- name of LZH file whose contents             *)
  18. (*                          are to be listed.                           *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*          Dir_Convert_Date_And_Time                                   *)
  23. (*          Start_Library_Listing                                       *)
  24. (*          End_Library_Listing                                         *)
  25. (*          Display_Page_Titles                                         *)
  26. (*          Entry_Matches                                               *)
  27. (*                                                                      *)
  28. (*----------------------------------------------------------------------*)
  29.  
  30. (*----------------------------------------------------------------------*)
  31. (*                  Map of LZH file entry header                        *)
  32. (*----------------------------------------------------------------------*)
  33.  
  34. TYPE
  35.    Char5           = ARRAY[ 1 .. 5  ] OF CHAR;
  36.  
  37.    LZH_Entry_Bytes = ARRAY[ 0 .. 21 ] OF BYTE;
  38.  
  39.    LZH_Entry_Type  = RECORD
  40.                         RecLen   : BYTE      (* Header record length     *);
  41.                         CheckSum : BYTE      (* Checksum of header bytes *);
  42.                         Compress : Char5     (* Compression type         *);
  43.                         CSize    : LONGINT   (* Compressed size          *);
  44.                         OSize    : LONGINT   (* Original size            *);
  45.                         Time     : WORD      (* Packed time              *);
  46.                         Date     : WORD      (* Packed date              *);
  47.                         Attr     : WORD      (* File attributes          *);
  48.                         FNameLen : BYTE      (* Length of file name      *);
  49.                      END;
  50.  
  51. VAR
  52.    LZHFile       : FILE                 (* LZH file to be read            *);
  53.    LZH_Entry     : LZH_Entry_Type       (* Header for one file in library *);
  54.    LZH_Pos       : LONGINT              (* Current byte offset in library *);
  55.    Bytes_Read    : INTEGER              (* # bytes read from library file *);
  56.    Ierr          : INTEGER              (* Error flag                     *);
  57.    Display_Entry : BOOLEAN              (* TRUE to display this entry     *);
  58.    FName         : AnyStr               (* Short file name                *);
  59.    Long_Name     : AnyStr               (* Long file name                 *);
  60.    DirS          : DirStr               (* Directory name                 *);
  61.    FExt          : ExtStr               (* Extension of file name         *);
  62.    CheckSum      : INTEGER              (* Header checksum                *);
  63.  
  64. (*----------------------------------------------------------------------*)
  65. (*   Get_Next_LZH_Entry --- Get next header entry in library            *)
  66. (*----------------------------------------------------------------------*)
  67.  
  68. FUNCTION Get_Next_LZH_Entry( VAR LZHEntry      : LZH_Entry_Type;
  69.                              VAR Display_Entry : BOOLEAN;
  70.                              VAR Error         : INTEGER ) : BOOLEAN;
  71.  
  72. (*----------------------------------------------------------------------*)
  73. (*                                                                      *)
  74. (*    Function:  Get_Next_LZH_Entry                                     *)
  75. (*                                                                      *)
  76. (*    Purpose:   Gets header information for next file in library       *)
  77. (*                                                                      *)
  78. (*    Calling sequence:                                                 *)
  79. (*                                                                      *)
  80. (*       OK := Get_Next_LZH_Entry( VAR LZHEntry :                       *)
  81. (*                                     LZH_Entry_Type;                  *)
  82. (*                                 VAR Display_Entry : BOOLEAN;         *)
  83. (*                                 VAR Error    : INTEGER ) :           *)
  84. (*                                 BOOLEAN;                             *)
  85. (*                                                                      *)
  86. (*          LZHEntry      --- Header data for next file in library      *)
  87. (*          Display_Entry --- TRUE to display this entry                *)
  88. (*          Error         --- Error flag                                *)
  89. (*          OK            --- TRUE if header successfully found         *)
  90. (*                                                                      *)
  91. (*----------------------------------------------------------------------*)
  92.  
  93. VAR
  94.    I         : INTEGER;
  95.    LZHBuffer : LZH_Entry_Bytes ABSOLUTE LZH_Entry;
  96.  
  97. BEGIN (* Get_Next_LZH_Entry *)
  98.                                    (* Assume no error to start       *)
  99.    Error         := 0;
  100.                                    (* Assume we don't display this   *)
  101.                                    (* entry.                         *)
  102.    Display_Entry      := FALSE;
  103.    Get_Next_LZH_Entry := FALSE;
  104.                                    (* Except first time, move to     *)
  105.                                    (* next supposed header record in *)
  106.                                    (* library.                       *)
  107.    IF ( LZH_Pos <> 0 ) THEN
  108.       Seek( LZHFile, LZH_Pos );
  109.                                    (* Check for I/O error            *)
  110.    IF ( IOResult <> 0 ) THEN
  111.       BEGIN
  112.          Error := Format_Error;
  113.          EXIT;
  114.       END;
  115.                                    (* Read in the file header entry. *)
  116.  
  117.    BlockRead( LZHFile, LZHEntry, SIZEOF( LZHEntry ), Bytes_Read );
  118.  
  119.                                    (* Check for I/O error            *)
  120.    IF ( IOResult <> 0 ) THEN
  121.       BEGIN
  122.          Error := Format_Error;
  123.          EXIT;
  124.       END;
  125.                                    (* If wrong size read, or header marker *)
  126.                                    (* is incorrect, report library format  *)
  127.                                    (* error.                               *)
  128.  
  129.    IF ( Bytes_Read <> SIZEOF( LZHEntry ) ) THEN
  130.       BEGIN
  131.          IF ( LZHEntry.RecLen = 0 ) THEN
  132.             Error := End_Of_File
  133.          ELSE
  134.             Error := Format_Error;
  135.       END
  136.    ELSE                            (* Header looks ok. *)
  137.       WITH LZHEntry DO
  138.          BEGIN
  139.                                    (* Pick up file name. *)
  140.  
  141.             BlockRead( LZHFile, Long_Name[ 1 ], LZHEntry.FNameLen, Bytes_Read );
  142.  
  143.                                    (* Check for I/O error            *)
  144.  
  145.             IF ( IOResult <> 0 ) THEN
  146.                BEGIN
  147.                   Error := Format_Error;
  148.                   EXIT;
  149.                END;
  150.                                    (* Set length of file name *)
  151.  
  152.             Long_Name[ 0 ] := CHR( Bytes_Read );
  153.  
  154.                                    (* Position to next header. *)
  155.  
  156.             LZH_Pos := LZH_Pos + LZHEntry.CSize + SIZEOF( LZHEntry ) +
  157.                        Bytes_Read + 2;
  158.  
  159.                                    (* Compute checksum of header *)
  160.             CheckSum := 0;
  161.  
  162.             FOR I := 1 TO 21 DO
  163.                CheckSum := ( CheckSum + LZHBuffer[ I ] ) AND 255;
  164.  
  165.             FOR I := 1 TO Bytes_Read DO
  166.                CheckSum := ( CheckSum + ORD( Long_Name[ I ] ) ) AND 255;
  167.  
  168.                                     (* If checksum wrong, quit.          *)
  169.  
  170.             IF ( CheckSum <> LZH_Entry.CheckSum ) THEN
  171.                Error := Format_Error;
  172.  
  173.          END;
  174.                                     (* Report success/failure to calling *)
  175.                                     (* routine.                          *)
  176.  
  177.    Display_Entry      := ( Error = 0 );
  178.    Get_Next_LZH_Entry := Display_Entry;
  179.  
  180. END   (* Get_Next_LZH_Entry *);
  181.  
  182. (*----------------------------------------------------------------------*)
  183. (*      Display_LZH_Entry --- Display file entry info                   *)
  184. (*----------------------------------------------------------------------*)
  185.  
  186. PROCEDURE Display_LZH_Entry( LZH_Entry : LZH_Entry_Type );
  187.  
  188. VAR
  189.    TimeDate  : LONGINT;
  190.    TimeDateW : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;
  191.  
  192. BEGIN (* Display_LZH_Entry *)
  193.  
  194.    WITH LZH_Entry DO
  195.       BEGIN
  196.                                    (* Extract short file name from   *)
  197.                                    (* long file name.                *)
  198.  
  199.          FSplit( Long_Name, DirS, FName, FExt );
  200.  
  201.          FName := FName + FExt;
  202.  
  203.                                    (* See if this file matches the   *)
  204.                                    (* entry spec wildcard.  Exit if  *)
  205.                                    (* not.                           *)
  206.          IF Use_Entry_Spec THEN
  207.             IF ( NOT Entry_Matches( FName ) ) THEN
  208.                EXIT;
  209.                                    (* Get date and time of creation *)
  210.          TimeDateW[ 1 ] := Time;
  211.          TimeDateW[ 2 ] := Date;
  212.  
  213.                                    (* Zap long file name if same  *)
  214.                                    (* as short file name.         *)
  215.  
  216.          IF ( Long_Name = FName ) THEN
  217.             Long_Name := '';
  218.  
  219.                                    (* Display info for this entry *)
  220.  
  221.          Display_One_Entry( FName, OSize, TimeDate, LZHFileName,
  222.                             Current_Subdirectory, Long_Name );
  223.  
  224.       END;
  225.  
  226. END (* Display_LZH_Entry *);
  227.  
  228. (*----------------------------------------------------------------------*)
  229.  
  230. BEGIN (* Display_LZH_Contents *)
  231.  
  232.                                    (* Note if LZH or LZS type.         *)
  233.  
  234.    FSplit( LZHFileName, DirS, FName, FExt );
  235.  
  236.    IF ( LENGTH( FExt ) > 1 ) THEN
  237.       IF ( FExt[ 1 ] = '.' ) THEN
  238.          DELETE( FExt, 1, 1 );
  239.                                    (* Open library file and initialize *)
  240.                                    (* contents display.                *)
  241.  
  242.    IF Start_Contents_Listing( ' ' + FExt + ' file: ',
  243.                               Current_Subdirectory + LZHFileName, LZHFile,
  244.                               LZH_Pos, Ierr ) THEN
  245.       BEGIN
  246.                                    (* Loop over entries in library file *)
  247.  
  248.          WHILE( Get_Next_LZH_Entry( LZH_Entry , Display_Entry , Ierr ) ) DO
  249.             IF Display_Entry THEN
  250.                Display_LZH_Entry( LZH_Entry );
  251.  
  252.                                    (* Close library files, complete display *)
  253.  
  254.          End_Contents_Listing( LZHFile , Ierr );
  255.  
  256.       END;
  257.  
  258. END   (* Display_LZH_Contents *);
  259.